home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of MacTutor - S…e Code for Volumes 1 to 5
/
The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin
/
Source Code
/
#46 (Jul 89)
/
Forth Stuff
/
forth source
next >
Wrap
Text File
|
1989-06-08
|
4KB
|
171 lines
only forth also assembler
\ Appletalk LAP protocol handler example
\ 12.05.89 JL
$904 constant currentA5
DECIMAL
12 constant ioCompletion
18 constant ioFileName
18 constant userData
24 constant ioRefNum
26 constant csCode
27 constant ioPermission
28 constant socket
28 constant protType
30 constant addrBlock
30 constant handler
9 constant mppUnitNum
mppUnitNum 1+ negate
constant mppRefNum
\ LAP defs
1 constant LAPshortDDP
2 constant LAPLongDDP
-94 constant lapProtErr
-95 constant lapExcessCollns
243 constant lapWrite
244 constant lapDetachPH
245 constant lapAttachPH
-1 constant lapOverrunErr
-2 constant lapCRCErr
-3 constant lapUnderrunErr
-4 constant lapLengthErr
\ DDP defs
5 constant ddpHdSzShort
13 constant ddpHdSzLong
1 constant ddpRTMP
2 constant ddpNBP
3 constant ddpATP
$7F constant ddpMaxWKS
586 constant ddpMaxData
$3ff constant ddpLengthMask
128 constant ddpWKS
-91 constant ddpSktErr
-92 constant ddpLenErr
-93 constant ddpNoBridgeErr
\ CsCode values for DDP Control calls- MPP
246 constant ddpWrite
247 constant ddpCloseSkt
248 constant ddpOpenSkt
256 constant setSelfSend
$1FA constant pRamByte
$1FB constant SPConfig
$291 constant portBUse
$2D8 constant ABusVars
$2DC constant ABusDCE
\ ABusVars block
0 constant sysLAPAddr
1 constant toRHA
8 constant dstNetNum
25 constant sysABridge
26 constant sysNetNum
28 constant vSCCEnable
header handler.start
header ATPblock 50 allot
header LAP1block 8 allot
header packet 586 allot
.trap _control,async $a404
.trap _newptr,sys $a51E
CODE myLAP2
moveq.l #ddpHdSzLong-2,D3
move.w sysNetNum(a2),D2
jsr (a4)
bne @2
cmp.w dstNetNum(a2),d2
bne @1
lea packet,a3
move.l #586,d3
jsr 2(a4)
bne @2
lea LAP1block,a0
move.b toRHA(a2),(a0) \ dest node ID
move.b toRHA+1(a2),1(a0) \ source node ID
move.b #1,2(a0) \ LAP type = 1
move.b toRHA+3(a2),3(a0) \ length field MSB
move.b toRHA+4(a2),4(a0) \ length field LSB
move.b toRHA+13(a2),5(a0) \ dest skt number
move.b toRHA+14(a2),6(a0) \ src skt number
move.b toRHA+15(a2),7(a0) \ DDP prot type
\ _debugger
\ set up parameter block for LAPwrite call
\ lea ATPblock,a0
\ move.w #mppRefNum,ioRefNum(a0)
\ move.l #0,ioCompletion(a0)
\ move.w #LAPwrite,csCode(a0)
\ lea LAP1block,a1
\ move.l a1,addrBlock(a0)
\ move.w vSCCEnable(a2),sr \ re-enable interrupts
\ _control,async
@2 rts
@1 moveq.l #0,d3
jmp 2(a4)
END-CODE
header handler.end
: call.mpp
mppRefNum ['] ATPBlock ioRefNum + w!
['] ATPBlock call control
;
: attach.ph ( protType handler -- flag )
( handler ) ['] ATPBlock handler + !
( protType ) ['] ATPBlock protType + c!
lapAttachPH ['] ATPBlock csCode + w!
call.mpp
;
: detach.ph ( protType -- flag )
( protType ) ['] ATPBlock protType + c!
lapDetachPH ['] ATPBlock csCode + w!
call.mpp
;
: set.self.send ( self_send_flag | old_flag -- )
setSelfSend ['] ATPBlock csCode + w!
( flag ) ['] ATPBlock 28 + c!
call.mpp drop \ result code
['] ATPBlock 29 + c@
;
: get.sys.block
['] handler.end ['] handler.start -
MOVE.L (A6)+,D0
_newptr,sys ( get memory block in system heap )
MOVE.L A0,-(A6)
;
: change.prots { | protPtr -- }
get.sys.block -> protPtr
protPtr IF
['] handler.start protPtr
['] handler.end ['] handler.start - cmove
2 detach.ph
abort" Could not detach protocol handler"
2 ['] myLAP2 ['] handler.start -
protPtr +
attach.ph
abort" Could not attach protocol handler"
255 set.self.send drop
ELSE ." Could not get memory for protocol handler"
THEN
cr ." Buffer area is at " protPtr 50 + . cr
;